home *** CD-ROM | disk | FTP | other *** search
/ Complete Internet Archive / Complete Internet Archive.iso / VRML / cp2b2x.exe / DATA.Z / listbox.tcl < prev    next >
Text File  |  1996-04-23  |  11KB  |  438 lines
  1. # listbox.tcl --
  2. #
  3. # This file defines the default bindings for Tk listbox widgets
  4. # and provides procedures that help in implementing those bindings.
  5. #
  6. # @(#) listbox.tcl 1.13 95/08/22 08:50:03
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  
  14. #--------------------------------------------------------------------------
  15. # tkPriv elements used in this file:
  16. #
  17. # afterId -        Token returned by "after" for autoscanning.
  18. # listboxPrev -        The last element to be selected or deselected
  19. #            during a selection operation.
  20. # listboxSelection -    All of the items that were selected before the
  21. #            current selection operation (such as a mouse
  22. #            drag) started;  used to cancel an operation.
  23. #--------------------------------------------------------------------------
  24.  
  25. #-------------------------------------------------------------------------
  26. # The code below creates the default class bindings for listboxes.
  27. #-------------------------------------------------------------------------
  28.  
  29. # Note: the check for existence of %W below is because this binding
  30. # is sometimes invoked after a window has been deleted (e.g. because
  31. # there is a double-click binding on the widget that deletes it).  Users
  32. # can put "break"s in their bindings to avoid the error, but this check
  33. # makes that unnecessary.
  34.  
  35. bind Listbox <1> {
  36.     if [winfo exists %W] {
  37.     tkListboxBeginSelect %W [%W index @%x,%y]
  38.     }
  39. }
  40. bind Listbox <B1-Motion> {
  41.     set tkPriv(x) %x
  42.     set tkPriv(y) %y
  43.     tkListboxMotion %W [%W index @%x,%y]
  44. }
  45. bind Listbox <ButtonRelease-1> {
  46.     tkCancelRepeat
  47.     %W activate @%x,%y
  48. }
  49. bind Listbox <Shift-1> {
  50.     tkListboxBeginExtend %W [%W index @%x,%y]
  51. }
  52. bind Listbox <Control-1> {
  53.     tkListboxBeginToggle %W [%W index @%x,%y]
  54. }
  55. bind Listbox <B1-Leave> {
  56.     set tkPriv(x) %x
  57.     set tkPriv(y) %y
  58.     tkListboxAutoScan %W
  59. }
  60. bind Listbox <B1-Enter> {
  61.     tkCancelRepeat
  62. }
  63.  
  64. bind Listbox <Up> {
  65.     tkListboxUpDown %W -1
  66. }
  67. bind Listbox <Shift-Up> {
  68.     tkListboxExtendUpDown %W -1
  69. }
  70. bind Listbox <Down> {
  71.     tkListboxUpDown %W 1
  72. }
  73. bind Listbox <Shift-Down> {
  74.     tkListboxExtendUpDown %W 1
  75. }
  76. bind Listbox <Left> {
  77.     %W xview scroll -1 units
  78. }
  79. bind Listbox <Control-Left> {
  80.     %W xview scroll -1 pages
  81. }
  82. bind Listbox <Right> {
  83.     %W xview scroll 1 units
  84. }
  85. bind Listbox <Control-Right> {
  86.     %W xview scroll 1 pages
  87. }
  88. bind Listbox <Prior> {
  89.     %W yview scroll -1 pages
  90.     %W activate @0,0
  91. }
  92. bind Listbox <Next> {
  93.     %W yview scroll 1 pages
  94.     %W activate @0,0
  95. }
  96. bind Listbox <Control-Prior> {
  97.     %W xview scroll -1 pages
  98. }
  99. bind Listbox <Control-Next> {
  100.     %W xview scroll 1 pages
  101. }
  102. bind Listbox <Home> {
  103.     %W xview moveto 0
  104. }
  105. bind Listbox <End> {
  106.     %W xview moveto 1
  107. }
  108. bind Listbox <Control-Home> {
  109.     %W activate 0
  110.     %W see 0
  111.     %W selection clear 0 end
  112.     %W selection set 0
  113. }
  114. bind Listbox <Shift-Control-Home> {
  115.     tkListboxDataExtend %W 0
  116. }
  117. bind Listbox <Control-End> {
  118.     %W activate end
  119.     %W see end
  120.     %W selection clear 0 end
  121.     %W selection set end
  122. }
  123. bind Listbox <Shift-Control-End> {
  124.     tkListboxDataExtend %W end
  125. }
  126. bind Listbox <F16> {
  127.     if {[selection own -displayof %W] == "%W"} {
  128.     clipboard clear -displayof %W
  129.     clipboard append -displayof %W [selection get -displayof %W]
  130.     }
  131. }
  132. bind Listbox <space> {
  133.     tkListboxBeginSelect %W [%W index active]
  134. }
  135. bind Listbox <Select> {
  136.     tkListboxBeginSelect %W [%W index active]
  137. }
  138. bind Listbox <Control-Shift-space> {
  139.     tkListboxBeginExtend %W [%W index active]
  140. }
  141. bind Listbox <Shift-Select> {
  142.     tkListboxBeginExtend %W [%W index active]
  143. }
  144. bind Listbox <Escape> {
  145.     tkListboxCancel %W
  146. }
  147. bind Listbox <Control-slash> {
  148.     tkListboxSelectAll %W
  149. }
  150. bind Listbox <Control-backslash> {
  151.     if {[%W cget -selectmode] != "browse"} {
  152.     %W selection clear 0 end
  153.     }
  154. }
  155.  
  156. # Additional Tk bindings that aren't part of the Motif look and feel:
  157.  
  158. bind Listbox <2> {
  159.     %W scan mark %x %y
  160. }
  161. bind Listbox <B2-Motion> {
  162.     %W scan dragto %x %y
  163. }
  164.  
  165. # tkListboxBeginSelect --
  166. #
  167. # This procedure is typically invoked on button-1 presses.  It begins
  168. # the process of making a selection in the listbox.  Its exact behavior
  169. # depends on the selection mode currently in effect for the listbox;
  170. # see the Motif documentation for details.
  171. #
  172. # Arguments:
  173. # w -        The listbox widget.
  174. # el -        The element for the selection operation (typically the
  175. #        one under the pointer).  Must be in numerical form.
  176.  
  177. proc tkListboxBeginSelect {w el} {
  178.     global tkPriv
  179.     if {[$w cget -selectmode]  == "multiple"} {
  180.     if [$w selection includes $el] {
  181.         $w selection clear $el
  182.     } else {
  183.         $w selection set $el
  184.     }
  185.     } else {
  186.     $w selection clear 0 end
  187.     $w selection set $el
  188.     $w selection anchor $el
  189.     set tkPriv(listboxSelection) {}
  190.     set tkPriv(listboxPrev) $el
  191.     }
  192. }
  193.  
  194. # tkListboxMotion --
  195. #
  196. # This procedure is called to process mouse motion events while
  197. # button 1 is down.  It may move or extend the selection, depending
  198. # on the listbox's selection mode.
  199. #
  200. # Arguments:
  201. # w -        The listbox widget.
  202. # el -        The element under the pointer (must be a number).
  203.  
  204. proc tkListboxMotion {w el} {
  205.     global tkPriv
  206.     if {$el == $tkPriv(listboxPrev)} {
  207.     return
  208.     }
  209.     set anchor [$w index anchor]
  210.     switch [$w cget -selectmode] {
  211.     browse {
  212.         $w selection clear 0 end
  213.         $w selection set $el
  214.         set tkPriv(listboxPrev) $el
  215.     }
  216.     extended {
  217.         set i $tkPriv(listboxPrev)
  218.         if [$w selection includes anchor] {
  219.         $w selection clear $i $el
  220.         $w selection set anchor $el
  221.         } else {
  222.         $w selection clear $i $el
  223.         $w selection clear anchor $el
  224.         }
  225.         while {($i < $el) && ($i < $anchor)} {
  226.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  227.             $w selection set $i
  228.         }
  229.         incr i
  230.         }
  231.         while {($i > $el) && ($i > $anchor)} {
  232.         if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
  233.             $w selection set $i
  234.         }
  235.         incr i -1
  236.         }
  237.         set tkPriv(listboxPrev) $el
  238.     }
  239.     }
  240. }
  241.  
  242. # tkListboxBeginExtend --
  243. #
  244. # This procedure is typically invoked on shift-button-1 presses.  It
  245. # begins the process of extending a selection in the listbox.  Its
  246. # exact behavior depends on the selection mode currently in effect
  247. # for the listbox;  see the Motif documentation for details.
  248. #
  249. # Arguments:
  250. # w -        The listbox widget.
  251. # el -        The element for the selection operation (typically the
  252. #        one under the pointer).  Must be in numerical form.
  253.  
  254. proc tkListboxBeginExtend {w el} {
  255.     if {([$w cget -selectmode] == "extended")
  256.         && [$w selection includes anchor]} {
  257.     tkListboxMotion $w $el
  258.     }
  259. }
  260.  
  261. # tkListboxBeginToggle --
  262. #
  263. # This procedure is typically invoked on control-button-1 presses.  It
  264. # begins the process of toggling a selection in the listbox.  Its
  265. # exact behavior depends on the selection mode currently in effect
  266. # for the listbox;  see the Motif documentation for details.
  267. #
  268. # Arguments:
  269. # w -        The listbox widget.
  270. # el -        The element for the selection operation (typically the
  271. #        one under the pointer).  Must be in numerical form.
  272.  
  273. proc tkListboxBeginToggle {w el} {
  274.     global tkPriv
  275.     if {[$w cget -selectmode] == "extended"} {
  276.     set tkPriv(listboxSelection) [$w curselection]
  277.     set tkPriv(listboxPrev) $el
  278.     $w selection anchor $el
  279.     if [$w selection includes $el] {
  280.         $w selection clear $el
  281.     } else {
  282.         $w selection set $el
  283.     }
  284.     }
  285. }
  286.  
  287. # tkListboxAutoScan --
  288. # This procedure is invoked when the mouse leaves an entry window
  289. # with button 1 down.  It scrolls the window up, down, left, or
  290. # right, depending on where the mouse left the window, and reschedules
  291. # itself as an "after" command so that the window continues to scroll until
  292. # the mouse moves back into the window or the mouse button is released.
  293. #
  294. # Arguments:
  295. # w -        The entry window.
  296.  
  297. proc tkListboxAutoScan {w} {
  298.     global tkPriv
  299.     set x $tkPriv(x)
  300.     set y $tkPriv(y)
  301.     if {$y >= [winfo height $w]} {
  302.     $w yview scroll 1 units
  303.     } elseif {$y < 0} {
  304.     $w yview scroll -1 units
  305.     } elseif {$x >= [winfo width $w]} {
  306.     $w xview scroll 2 units
  307.     } elseif {$x < 0} {
  308.     $w xview scroll -2 units
  309.     } else {
  310.     return
  311.     }
  312.     tkListboxMotion $w [$w index @$x,$y]
  313.     set tkPriv(afterId) [after 50 tkListboxAutoScan $w]
  314. }
  315.  
  316. # tkListboxUpDown --
  317. #
  318. # Moves the location cursor (active element) up or down by one element,
  319. # and changes the selection if we're in browse or extended selection
  320. # mode.
  321. #
  322. # Arguments:
  323. # w -        The listbox widget.
  324. # amount -    +1 to move down one item, -1 to move back one item.
  325.  
  326. proc tkListboxUpDown {w amount} {
  327.     global tkPriv
  328.     $w activate [expr [$w index active] + $amount]
  329.     $w see active
  330.     switch [$w cget -selectmode] {
  331.     browse {
  332.         $w selection clear 0 end
  333.         $w selection set active
  334.     }
  335.     extended {
  336.         $w selection clear 0 end
  337.         $w selection set active
  338.         $w selection anchor active
  339.         set tkPriv(listboxPrev) [$w index active]
  340.         set tkPriv(listboxSelection) {}
  341.     }
  342.     }
  343. }
  344.  
  345. # tkListboxExtendUpDown --
  346. #
  347. # Does nothing unless we're in extended selection mode;  in this
  348. # case it moves the location cursor (active element) up or down by
  349. # one element, and extends the selection to that point.
  350. #
  351. # Arguments:
  352. # w -        The listbox widget.
  353. # amount -    +1 to move down one item, -1 to move back one item.
  354.  
  355. proc tkListboxExtendUpDown {w amount} {
  356.     if {[$w cget -selectmode] != "extended"} {
  357.     return
  358.     }
  359.     $w activate [expr [$w index active] + $amount]
  360.     $w see active
  361.     tkListboxMotion $w [$w index active]
  362. }
  363.  
  364. # tkListboxDataExtend
  365. #
  366. # This procedure is called for key-presses such as Shift-KEndData.
  367. # If the selection mode isn't multiple or extend then it does nothing.
  368. # Otherwise it moves the active element to el and, if we're in
  369. # extended mode, extends the selection to that point.
  370. #
  371. # Arguments:
  372. # w -        The listbox widget.
  373. # el -        An integer element number.
  374.  
  375. proc tkListboxDataExtend {w el} {
  376.     set mode [$w cget -selectmode]
  377.     if {$mode == "extended"} {
  378.     $w activate $el
  379.     $w see $el
  380.         if [$w selection includes anchor] {
  381.         tkListboxMotion $w $el
  382.     }
  383.     } elseif {$mode == "multiple"} {
  384.     $w activate $el
  385.     $w see $el
  386.     }
  387. }
  388.  
  389. # tkListboxCancel
  390. #
  391. # This procedure is invoked to cancel an extended selection in
  392. # progress.  If there is an extended selection in progress, it
  393. # restores all of the items between the active one and the anchor
  394. # to their previous selection state.
  395. #
  396. # Arguments:
  397. # w -        The listbox widget.
  398.  
  399. proc tkListboxCancel w {
  400.     global tkPriv
  401.     if {[$w cget -selectmode] != "extended"} {
  402.     return
  403.     }
  404.     set first [$w index anchor]
  405.     set last $tkPriv(listboxPrev)
  406.     if {$first > $last} {
  407.     set tmp $first
  408.     set first $last
  409.     set last $tmp
  410.     }
  411.     $w selection clear $first $last
  412.     while {$first <= $last} {
  413.     if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {
  414.         $w selection set $first
  415.     }
  416.     incr first
  417.     }
  418. }
  419.  
  420. # tkListboxSelectAll
  421. #
  422. # This procedure is invoked to handle the "select all" operation.
  423. # For single and browse mode, it just selects the active element.
  424. # Otherwise it selects everything in the widget.
  425. #
  426. # Arguments:
  427. # w -        The listbox widget.
  428.  
  429. proc tkListboxSelectAll w {
  430.     set mode [$w cget -selectmode]
  431.     if {($mode == "single") || ($mode == "browse")} {
  432.     $w selection clear 0 end
  433.     $w selection set active
  434.     } else {
  435.     $w selection set 0 end
  436.     }
  437. }
  438.